NASDAQ Weekly % Change Relative to Start of Year

#| echo: false
#| warning: false
#| message: false

# Load necessary libraries
library(quantmod)

Loading required package: xts

Loading required package: zoo

Attaching package: 'zoo'

The following objects are masked from 'package:base':

    as.Date, as.Date.numeric

Loading required package: TTR

Registered S3 method overwritten by 'quantmod':
  method            from
  as.zoo.data.frame zoo 

library(dplyr)

######################### Warning from 'xts' package ##########################
#                                                                             #
# The dplyr lag() function breaks how base R's lag() function is supposed to  #
# work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or       #
# source() into this session won't work correctly.                            #
#                                                                             #
# Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
# conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop           #
# dplyr from breaking base R's lag() function.                                #
#                                                                             #
# Code in packages is not affected. It's protected by R's namespace mechanism #
# Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning.  #
#                                                                             #
###############################################################################

Attaching package: 'dplyr'

The following objects are masked from 'package:xts':

    first, last

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

library(lubridate)

Attaching package: 'lubridate'

The following objects are masked from 'package:base':

    date, intersect, setdiff, union

library(plotly)

Loading required package: ggplot2

Attaching package: 'plotly'

The following object is masked from 'package:ggplot2':

    last_plot

The following object is masked from 'package:stats':

    filter

The following object is masked from 'package:graphics':

    layout

# Function to calculate weekly returns indexed to start of year
calculate_weekly_returns <- function(symbol, start_date, end_date) {
  data <- getSymbols(symbol, from = start_date, to = end_date, src = "yahoo", auto.assign = FALSE)
  prices <- Ad(data)
  
  df <- data.frame(date = index(prices), price = as.numeric(prices))
  df <- df %>%
    mutate(year = year(date),
           week = week(date)) %>%
    group_by(year, week) %>%
    summarise(date = last(date), price = last(price), .groups = 'drop') %>%
    arrange(date)
  
  df <- df %>%
    group_by(year) %>%
    mutate(pct_change = (price / first(price) - 1) * 100) %>%
    filter(week <= 52) %>%
    ungroup()
  
  return(df)
}

# Set date range
end_date <- Sys.Date()
start_date <- as.Date("2008-01-01")
start_year <- as.integer(format(start_date, "%Y"))

# Calculate weekly returns for NASDAQ - MAKE SURE THIS IS EXECUTED
nasdaq_returns <- calculate_weekly_returns("^IXIC", start_date, end_date)

# Split data into dataframes
df_historical <- nasdaq_returns %>% filter(year >= start_year & year <= 2024)
df_2025 <- nasdaq_returns %>% filter(year == 2025)
df_avg_historical <- df_historical %>%
  group_by(week) %>%
  summarise(avg_pct_change = mean(pct_change, na.rm = TRUE))

# Create the plot
p <- plot_ly()

# Add traces for historical data
p <- add_trace(p, x = ~week, y = ~pct_change, data = df_historical,
             type = 'scatter', mode = 'lines', split = ~year,
             line = list(color = 'grey', width = 1),
             opacity = 0.3,
             hoverinfo = "text",
             text = ~paste("Year:", year, "<br>Week:", week, "<br>Change:", round(pct_change, 2), "%"),
             showlegend = FALSE)

# Add a custom trace for the historical legend entry
p <- add_trace(p, x = c(1), y = c(NA), type = 'scatter', mode = 'lines',
             line = list(color = 'grey', width = 1),
             opacity = 0.3,
             name = '',
             hoverinfo = 'none')

# Add trace for 2025
if(nrow(df_2025) > 0) {
  p <- add_trace(p, x = ~week, y = ~pct_change, data = df_2025,
               type = 'scatter', mode = 'lines',
               line = list(color = '#336699', width = 2),
               name = '2025',
               hoverinfo = "text",
               text = ~paste("Year: 2025<br>Week:", week, "<br>Change:", round(pct_change, 2), "%"))
}

# Add trace for average of historical data
p <- add_trace(p, x = ~week, y = ~avg_pct_change, data = df_avg_historical,
             type = 'scatter', mode = 'lines',
             opacity = 1,
             line = list(color = 'darkred', width = 2, dash = 'dot'),
             name = paste0("Average (",start_year,"-2024)"),
             hoverinfo = "text",
             text = ~paste0("Year: Average (",start_year,"-2024)<br>Week:", week, "<br>Change:", round(avg_pct_change, 2), "%"))

# Update layout
p <- p %>% layout(
  xaxis = list(
    title = "Week", 
    range = c(1, 52),
    showgrid = FALSE,
    tickmode = "array",
    tickvals = c(1, 10, 20, 30, 40, 50),
    ticktext = c("1", "10", "20", "30", "40", "50")
  ),
  yaxis = list(title = "% Change"),
  showlegend = TRUE,
  legend = list(orientation = "h", y = 1.1),
  hovermode = "closest"
) %>%
config(
  displayModeBar = FALSE
)

# Add the highlight effect
p <- p %>% 
  highlight(
    on = "plotly_hover",
    off = "plotly_doubleclick",  # Changed from "plotly_unhover" to a valid option
    selected = list(line = list(color = "black", width = 3)),
    opacityDim = 0.2
  )

# Display the plot
p